home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 98 / Skunkware 98.iso / src / interp / perl5.005.tar.gz / perl5.005.tar / perl5.005 / av.c < prev    next >
C/C++ Source or Header  |  1998-07-21  |  13KB  |  659 lines
  1. /*    av.c
  2.  *
  3.  *    Copyright (c) 1991-1997, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  */
  9.  
  10. /*
  11.  * "...for the Entwives desired order, and plenty, and peace (by which they
  12.  * meant that things should remain where they had set them)." --Treebeard
  13.  */
  14.  
  15. #include "EXTERN.h"
  16. #include "perl.h"
  17.  
  18. void
  19. av_reify(AV *av)
  20. {
  21.     I32 key;
  22.     SV* sv;
  23.  
  24.     if (AvREAL(av))
  25.     return;
  26. #ifdef DEBUGGING
  27.     if (SvRMAGICAL(av) && mg_find((SV*)av,'P'))
  28.     warn("av_reify called on tied array");
  29. #endif
  30.     key = AvMAX(av) + 1;
  31.     while (key > AvFILLp(av) + 1)
  32.     AvARRAY(av)[--key] = &PL_sv_undef;
  33.     while (key) {
  34.     sv = AvARRAY(av)[--key];
  35.     assert(sv);
  36.     if (sv != &PL_sv_undef) {
  37.         dTHR;
  38.         (void)SvREFCNT_inc(sv);
  39.     }
  40.     }
  41.     key = AvARRAY(av) - AvALLOC(av);
  42.     while (key)
  43.     AvALLOC(av)[--key] = &PL_sv_undef;
  44.     AvREAL_on(av);
  45. }
  46.  
  47. void
  48. av_extend(AV *av, I32 key)
  49. {
  50.     dTHR;            /* only necessary if we have to extend stack */
  51.     MAGIC *mg;
  52.     if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) {
  53.     dSP;
  54.     ENTER;
  55.     SAVETMPS;
  56.     PUSHSTACKi(PERLSI_MAGIC);
  57.     PUSHMARK(SP);
  58.     EXTEND(SP,2);
  59.     PUSHs(mg->mg_obj);
  60.     PUSHs(sv_2mortal(newSViv(key+1)));
  61.         PUTBACK;
  62.     perl_call_method("EXTEND", G_SCALAR|G_DISCARD);
  63.     POPSTACK;
  64.     FREETMPS;
  65.     LEAVE;
  66.     return;
  67.     }
  68.     if (key > AvMAX(av)) {
  69.     SV** ary;
  70.     I32 tmp;
  71.     I32 newmax;
  72.  
  73.     if (AvALLOC(av) != AvARRAY(av)) {
  74.         ary = AvALLOC(av) + AvFILLp(av) + 1;
  75.         tmp = AvARRAY(av) - AvALLOC(av);
  76.         Move(AvARRAY(av), AvALLOC(av), AvFILLp(av)+1, SV*);
  77.         AvMAX(av) += tmp;
  78.         SvPVX(av) = (char*)AvALLOC(av);
  79.         if (AvREAL(av)) {
  80.         while (tmp)
  81.             ary[--tmp] = &PL_sv_undef;
  82.         }
  83.         
  84.         if (key > AvMAX(av) - 10) {
  85.         newmax = key + AvMAX(av);
  86.         goto resize;
  87.         }
  88.     }
  89.     else {
  90.         if (AvALLOC(av)) {
  91. #ifndef STRANGE_MALLOC
  92.         U32 bytes;
  93. #endif
  94.  
  95. #if defined(MYMALLOC) && !defined(PURIFY) && !defined(LEAKTEST)
  96.         newmax = malloced_size((void*)AvALLOC(av))/sizeof(SV*) - 1;
  97.  
  98.         if (key <= newmax) 
  99.             goto resized;
  100. #endif 
  101.         newmax = key + AvMAX(av) / 5;
  102.           resize:
  103. #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
  104.         Renew(AvALLOC(av),newmax+1, SV*);
  105. #else
  106.         bytes = (newmax + 1) * sizeof(SV*);
  107. #define MALLOC_OVERHEAD 16
  108.         tmp = MALLOC_OVERHEAD;
  109.         while (tmp - MALLOC_OVERHEAD < bytes)
  110.             tmp += tmp;
  111.         tmp -= MALLOC_OVERHEAD;
  112.         tmp /= sizeof(SV*);
  113.         assert(tmp > newmax);
  114.         newmax = tmp - 1;
  115.         New(2,ary, newmax+1, SV*);
  116.         Copy(AvALLOC(av), ary, AvMAX(av)+1, SV*);
  117.         if (AvMAX(av) > 64)
  118.             offer_nice_chunk(AvALLOC(av), (AvMAX(av)+1) * sizeof(SV*));
  119.         else
  120.             Safefree(AvALLOC(av));
  121.         AvALLOC(av) = ary;
  122. #endif
  123.           resized:
  124.         ary = AvALLOC(av) + AvMAX(av) + 1;
  125.         tmp = newmax - AvMAX(av);
  126.         if (av == PL_curstack) {    /* Oops, grew stack (via av_store()?) */
  127.             PL_stack_sp = AvALLOC(av) + (PL_stack_sp - PL_stack_base);
  128.             PL_stack_base = AvALLOC(av);
  129.             PL_stack_max = PL_stack_base + newmax;
  130.         }
  131.         }
  132.         else {
  133.         newmax = key < 3 ? 3 : key;
  134.         New(2,AvALLOC(av), newmax+1, SV*);
  135.         ary = AvALLOC(av) + 1;
  136.         tmp = newmax;
  137.         AvALLOC(av)[0] = &PL_sv_undef;    /* For the stacks */
  138.         }
  139.         if (AvREAL(av)) {
  140.         while (tmp)
  141.             ary[--tmp] = &PL_sv_undef;
  142.         }
  143.         
  144.         SvPVX(av) = (char*)AvALLOC(av);
  145.         AvMAX(av) = newmax;
  146.     }
  147.     }
  148. }
  149.  
  150. SV**
  151. av_fetch(register AV *av, I32 key, I32 lval)
  152. {
  153.     SV *sv;
  154.  
  155.     if (!av)
  156.     return 0;
  157.  
  158.     if (key < 0) {
  159.     key += AvFILL(av) + 1;
  160.     if (key < 0)
  161.         return 0;
  162.     }
  163.  
  164.     if (SvRMAGICAL(av)) {
  165.     if (mg_find((SV*)av,'P')) {
  166.         dTHR;
  167.         sv = sv_newmortal();
  168.         mg_copy((SV*)av, sv, 0, key);
  169.         PL_av_fetch_sv = sv;
  170.         return &PL_av_fetch_sv;
  171.     }
  172.     }
  173.  
  174.     if (key > AvFILLp(av)) {
  175.     if (!lval)
  176.         return 0;
  177.     if (AvREALISH(av))
  178.         sv = NEWSV(5,0);
  179.     else
  180.         sv = sv_newmortal();
  181.     return av_store(av,key,sv);
  182.     }
  183.     if (AvARRAY(av)[key] == &PL_sv_undef) {
  184.     emptyness:
  185.     if (lval) {
  186.         sv = NEWSV(6,0);
  187.         return av_store(av,key,sv);
  188.     }
  189.     return 0;
  190.     }
  191.     else if (AvREIFY(av)
  192.          && (!AvARRAY(av)[key]    /* eg. @_ could have freed elts */
  193.          || SvTYPE(AvARRAY(av)[key]) == SVTYPEMASK)) {
  194.     AvARRAY(av)[key] = &PL_sv_undef;    /* 1/2 reify */
  195.     goto emptyness;
  196.     }
  197.     return &AvARRAY(av)[key];
  198. }
  199.  
  200. SV**
  201. av_store(register AV *av, I32 key, SV *val)
  202. {
  203.     SV** ary;
  204.     U32  fill;
  205.  
  206.  
  207.     if (!av)
  208.     return 0;
  209.     if (!val)
  210.     val = &PL_sv_undef;
  211.  
  212.     if (key < 0) {
  213.     key += AvFILL(av) + 1;
  214.     if (key < 0)
  215.         return 0;
  216.     }
  217.  
  218.     if (SvREADONLY(av) && key >= AvFILL(av))
  219.     croak(no_modify);
  220.  
  221.     if (SvRMAGICAL(av)) {
  222.     if (mg_find((SV*)av,'P')) {
  223.         if (val != &PL_sv_undef) {
  224.         mg_copy((SV*)av, val, 0, key);
  225.         }
  226.         return 0;
  227.     }
  228.     }
  229.  
  230.     if (!AvREAL(av) && AvREIFY(av))
  231.     av_reify(av);
  232.     if (key > AvMAX(av))
  233.     av_extend(av,key);
  234.     ary = AvARRAY(av);
  235.     if (AvFILLp(av) < key) {
  236.     if (!AvREAL(av)) {
  237.         dTHR;
  238.         if (av == PL_curstack && key > PL_stack_sp - PL_stack_base)
  239.         PL_stack_sp = PL_stack_base + key;    /* XPUSH in disguise */
  240.         do
  241.         ary[++AvFILLp(av)] = &PL_sv_undef;
  242.         while (AvFILLp(av) < key);
  243.     }
  244.     AvFILLp(av) = key;
  245.     }
  246.     else if (AvREAL(av))
  247.     SvREFCNT_dec(ary[key]);
  248.     ary[key] = val;
  249.     if (SvSMAGICAL(av)) {
  250.     if (val != &PL_sv_undef) {
  251.         MAGIC* mg = SvMAGIC(av);
  252.         sv_magic(val, (SV*)av, toLOWER(mg->mg_type), 0, key);
  253.     }
  254.     mg_set((SV*)av);
  255.     }
  256.     return &ary[key];
  257. }
  258.  
  259. AV *
  260. newAV(void)
  261. {
  262.     register AV *av;
  263.  
  264.     av = (AV*)NEWSV(3,0);
  265.     sv_upgrade((SV *)av, SVt_PVAV);
  266.     AvREAL_on(av);
  267.     AvALLOC(av) = 0;
  268.     SvPVX(av) = 0;
  269.     AvMAX(av) = AvFILLp(av) = -1;
  270.     return av;
  271. }
  272.  
  273. AV *
  274. av_make(register I32 size, register SV **strp)
  275. {
  276.     register AV *av;
  277.     register I32 i;
  278.     register SV** ary;
  279.  
  280.     av = (AV*)NEWSV(8,0);
  281.     sv_upgrade((SV *) av,SVt_PVAV);
  282.     AvFLAGS(av) = AVf_REAL;
  283.     if (size) {        /* `defined' was returning undef for size==0 anyway. */
  284.     New(4,ary,size,SV*);
  285.     AvALLOC(av) = ary;
  286.     SvPVX(av) = (char*)ary;
  287.     AvFILLp(av) = size - 1;
  288.     AvMAX(av) = size - 1;
  289.     for (i = 0; i < size; i++) {
  290.         assert (*strp);
  291.         ary[i] = NEWSV(7,0);
  292.         sv_setsv(ary[i], *strp);
  293.         strp++;
  294.     }
  295.     }
  296.     return av;
  297. }
  298.  
  299. AV *
  300. av_fake(register I32 size, register SV **strp)
  301. {
  302.     register AV *av;
  303.     register SV** ary;
  304.  
  305.     av = (AV*)NEWSV(9,0);
  306.     sv_upgrade((SV *)av, SVt_PVAV);
  307.     New(4,ary,size+1,SV*);
  308.     AvALLOC(av) = ary;
  309.     Copy(strp,ary,size,SV*);
  310.     AvFLAGS(av) = AVf_REIFY;
  311.     SvPVX(av) = (char*)ary;
  312.     AvFILLp(av) = size - 1;
  313.     AvMAX(av) = size - 1;
  314.     while (size--) {
  315.     assert (*strp);
  316.     SvTEMP_off(*strp);
  317.     strp++;
  318.     }
  319.     return av;
  320. }
  321.  
  322. void
  323. av_clear(register AV *av)
  324. {
  325.     register I32 key;
  326.     SV** ary;
  327.  
  328. #ifdef DEBUGGING
  329.     if (SvREFCNT(av) <= 0) {
  330.     warn("Attempt to clear deleted array");
  331.     }
  332. #endif
  333.     if (!av)
  334.     return;
  335.     /*SUPPRESS 560*/
  336.  
  337.     if (SvREADONLY(av))
  338.     croak(no_modify);
  339.  
  340.     /* Give any tie a chance to cleanup first */
  341.     if (SvRMAGICAL(av))
  342.     mg_clear((SV*)av); 
  343.  
  344.     if (AvMAX(av) < 0)
  345.     return;
  346.  
  347.     if (AvREAL(av)) {
  348.     ary = AvARRAY(av);
  349.     key = AvFILLp(av) + 1;
  350.     while (key) {
  351.         SvREFCNT_dec(ary[--key]);
  352.         ary[key] = &PL_sv_undef;
  353.     }
  354.     }
  355.     if (key = AvARRAY(av) - AvALLOC(av)) {
  356.     AvMAX(av) += key;
  357.     SvPVX(av) = (char*)AvALLOC(av);
  358.     }
  359.     AvFILLp(av) = -1;
  360.  
  361. }
  362.  
  363. void
  364. av_undef(register AV *av)
  365. {
  366.     register I32 key;
  367.  
  368.     if (!av)
  369.     return;
  370.     /*SUPPRESS 560*/
  371.  
  372.     /* Give any tie a chance to cleanup first */
  373.     if (SvRMAGICAL(av) && mg_find((SV*)av,'P')) 
  374.     av_fill(av, -1);   /* mg_clear() ? */
  375.  
  376.     if (AvREAL(av)) {
  377.     key = AvFILLp(av) + 1;
  378.     while (key)
  379.         SvREFCNT_dec(AvARRAY(av)[--key]);
  380.     }
  381.     Safefree(AvALLOC(av));
  382.     AvALLOC(av) = 0;
  383.     SvPVX(av) = 0;
  384.     AvMAX(av) = AvFILLp(av) = -1;
  385.     if (AvARYLEN(av)) {
  386.     SvREFCNT_dec(AvARYLEN(av));
  387.     AvARYLEN(av) = 0;
  388.     }
  389. }
  390.  
  391. void
  392. av_push(register AV *av, SV *val)
  393. {             
  394.     MAGIC *mg;
  395.     if (!av)
  396.     return;
  397.     if (SvREADONLY(av))
  398.     croak(no_modify);
  399.  
  400.     if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) {
  401.     dSP;
  402.     PUSHSTACKi(PERLSI_MAGIC);
  403.     PUSHMARK(SP);
  404.     EXTEND(SP,2);
  405.     PUSHs(mg->mg_obj);
  406.     PUSHs(val);
  407.     PUTBACK;
  408.     ENTER;
  409.     perl_call_method("PUSH", G_SCALAR|G_DISCARD);
  410.     LEAVE;
  411.     POPSTACK;
  412.     return;
  413.     }
  414.     av_store(av,AvFILLp(av)+1,val);
  415. }
  416.  
  417. SV *
  418. av_pop(register AV *av)
  419. {
  420.     SV *retval;
  421.     MAGIC* mg;
  422.  
  423.     if (!av || AvFILL(av) < 0)
  424.     return &PL_sv_undef;
  425.     if (SvREADONLY(av))
  426.     croak(no_modify);
  427.     if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) {
  428.     dSP;    
  429.     PUSHSTACKi(PERLSI_MAGIC);
  430.     PUSHMARK(SP);
  431.     XPUSHs(mg->mg_obj);
  432.     PUTBACK;
  433.     ENTER;
  434.     if (perl_call_method("POP", G_SCALAR)) {
  435.         retval = newSVsv(*PL_stack_sp--);    
  436.     } else {    
  437.         retval = &PL_sv_undef;
  438.     }
  439.     LEAVE;
  440.     POPSTACK;
  441.     return retval;
  442.     }
  443.     retval = AvARRAY(av)[AvFILLp(av)];
  444.     AvARRAY(av)[AvFILLp(av)--] = &PL_sv_undef;
  445.     if (SvSMAGICAL(av))
  446.     mg_set((SV*)av);
  447.     return retval;
  448. }
  449.  
  450. void
  451. av_unshift(register AV *av, register I32 num)
  452. {
  453.     register I32 i;
  454.     register SV **ary;
  455.     MAGIC* mg;
  456.  
  457.     if (!av || num <= 0)
  458.     return;
  459.     if (SvREADONLY(av))
  460.     croak(no_modify);
  461.  
  462.     if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) {
  463.     dSP;
  464.     PUSHSTACKi(PERLSI_MAGIC);
  465.     PUSHMARK(SP);
  466.     EXTEND(SP,1+num);
  467.     PUSHs(mg->mg_obj);
  468.     while (num-- > 0) {
  469.         PUSHs(&PL_sv_undef);
  470.     }
  471.     PUTBACK;
  472.     ENTER;
  473.     perl_call_method("UNSHIFT", G_SCALAR|G_DISCARD);
  474.     LEAVE;
  475.     POPSTACK;
  476.     return;
  477.     }
  478.  
  479.     if (!AvREAL(av) && AvREIFY(av))
  480.     av_reify(av);
  481.     i = AvARRAY(av) - AvALLOC(av);
  482.     if (i) {
  483.     if (i > num)
  484.         i = num;
  485.     num -= i;
  486.     
  487.     AvMAX(av) += i;
  488.     AvFILLp(av) += i;
  489.     SvPVX(av) = (char*)(AvARRAY(av) - i);
  490.     }
  491.     if (num) {
  492.     i = AvFILLp(av);
  493.     av_extend(av, i + num);
  494.     AvFILLp(av) += num;
  495.     ary = AvARRAY(av);
  496.     Move(ary, ary + num, i + 1, SV*);
  497.     do {
  498.         ary[--num] = &PL_sv_undef;
  499.     } while (num);
  500.     }
  501. }
  502.  
  503. SV *
  504. av_shift(register AV *av)
  505. {
  506.     SV *retval;
  507.     MAGIC* mg;
  508.  
  509.     if (!av || AvFILL(av) < 0)
  510.     return &PL_sv_undef;
  511.     if (SvREADONLY(av))
  512.     croak(no_modify);
  513.     if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) {
  514.     dSP;
  515.     PUSHSTACKi(PERLSI_MAGIC);
  516.     PUSHMARK(SP);
  517.     XPUSHs(mg->mg_obj);
  518.     PUTBACK;
  519.     ENTER;
  520.     if (perl_call_method("SHIFT", G_SCALAR)) {
  521.         retval = newSVsv(*PL_stack_sp--);            
  522.     } else {    
  523.         retval = &PL_sv_undef;
  524.     }     
  525.     LEAVE;
  526.     POPSTACK;
  527.     return retval;
  528.     }
  529.     retval = *AvARRAY(av);
  530.     if (AvREAL(av))
  531.     *AvARRAY(av) = &PL_sv_undef;
  532.     SvPVX(av) = (char*)(AvARRAY(av) + 1);
  533.     AvMAX(av)--;
  534.     AvFILLp(av)--;
  535.     if (SvSMAGICAL(av))
  536.     mg_set((SV*)av);
  537.     return retval;
  538. }
  539.  
  540. I32
  541. av_len(register AV *av)
  542. {
  543.     return AvFILL(av);
  544. }
  545.  
  546. void
  547. av_fill(register AV *av, I32 fill)
  548. {
  549.     MAGIC *mg;
  550.     if (!av)
  551.     croak("panic: null array");
  552.     if (fill < 0)
  553.     fill = -1;
  554.     if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) {
  555.     dSP;            
  556.     ENTER;
  557.     SAVETMPS;
  558.     PUSHSTACKi(PERLSI_MAGIC);
  559.     PUSHMARK(SP);
  560.     EXTEND(SP,2);
  561.     PUSHs(mg->mg_obj);
  562.     PUSHs(sv_2mortal(newSViv(fill+1)));
  563.     PUTBACK;
  564.     perl_call_method("STORESIZE", G_SCALAR|G_DISCARD);
  565.     POPSTACK;
  566.     FREETMPS;
  567.     LEAVE;
  568.     return;
  569.     }
  570.     if (fill <= AvMAX(av)) {
  571.     I32 key = AvFILLp(av);
  572.     SV** ary = AvARRAY(av);
  573.  
  574.     if (AvREAL(av)) {
  575.         while (key > fill) {
  576.         SvREFCNT_dec(ary[key]);
  577.         ary[key--] = &PL_sv_undef;
  578.         }
  579.     }
  580.     else {
  581.         while (key < fill)
  582.         ary[++key] = &PL_sv_undef;
  583.     }
  584.         
  585.     AvFILLp(av) = fill;
  586.     if (SvSMAGICAL(av))
  587.         mg_set((SV*)av);
  588.     }
  589.     else
  590.     (void)av_store(av,fill,&PL_sv_undef);
  591. }
  592.  
  593.  
  594. /* AVHV: Support for treating arrays as if they were hashes.  The
  595.  * first element of the array should be a hash reference that maps
  596.  * hash keys to array indices.
  597.  */
  598.  
  599. STATIC I32
  600. avhv_index_sv(SV* sv)
  601. {
  602.     I32 index = SvIV(sv);
  603.     if (index < 1)
  604.     croak("Bad index while coercing array into hash");
  605.     return index;    
  606. }
  607.  
  608. HV*
  609. avhv_keys(AV *av)
  610. {
  611.     SV **keysp = av_fetch(av, 0, FALSE);
  612.     if (keysp) {
  613.     SV *sv = *keysp;
  614.     if (SvGMAGICAL(sv))
  615.         mg_get(sv);
  616.     if (SvROK(sv)) {
  617.         sv = SvRV(sv);
  618.         if (SvTYPE(sv) == SVt_PVHV)
  619.         return (HV*)sv;
  620.     }
  621.     }
  622.     croak("Can't coerce array into hash");
  623.     return Nullhv;
  624. }
  625.  
  626. SV**
  627. avhv_fetch_ent(AV *av, SV *keysv, I32 lval, U32 hash)
  628. {
  629.     SV **indsvp;
  630.     HV *keys = avhv_keys(av);
  631.     HE *he;
  632.     
  633.     he = hv_fetch_ent(keys, keysv, FALSE, hash);
  634.     if (!he)
  635.         croak("No such array field");
  636.     return av_fetch(av, avhv_index_sv(HeVAL(he)), lval);
  637. }
  638.  
  639. bool
  640. avhv_exists_ent(AV *av, SV *keysv, U32 hash)
  641. {
  642.     HV *keys = avhv_keys(av);
  643.     return hv_exists_ent(keys, keysv, hash);
  644. }
  645.  
  646. HE *
  647. avhv_iternext(AV *av)
  648. {
  649.     HV *keys = avhv_keys(av);
  650.     return hv_iternext(keys);
  651. }
  652.  
  653. SV *
  654. avhv_iterval(AV *av, register HE *entry)
  655. {
  656.     SV *sv = hv_iterval(avhv_keys(av), entry);
  657.     return *av_fetch(av, avhv_index_sv(sv), TRUE);
  658. }
  659.